home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.02 Feb 93 / Date FKEY / SystemResources.p < prev   
Encoding:
Text File  |  1992-08-23  |  3.0 KB  |  130 lines  |  [TEXT/PJMM]
  1. unit SystemResourcesXFCN;
  2. { usage in HyperCard: }
  3. {   put SystemResources("FKEY") into mySysResList  }
  4. { Rob Spencer    8/23/92  }
  5.  
  6. interface
  7.     uses
  8.         HyperXCMD;
  9.     procedure main (paramPtr: XCmdPtr);
  10.  
  11. implementation
  12.  
  13.     procedure main (paramPtr: XCmdPtr);
  14.         const
  15.             kAuthorStr = 'Rob Spencer   August 1992';
  16.             kFormStr = 'form: SystemResources <resType>';
  17.             kBadTypeCode = 'invalid resource type';
  18.             kOutOfMemory = 'out of memory';
  19.             space = char(32);
  20.             return = char(13);
  21.  
  22.  { ----------------------------- }
  23.  
  24.         procedure HandleError (myStr: str255);
  25.         begin
  26.             case myStr[1] of
  27.                 '!': 
  28.                     myStr := kAuthorStr;
  29.                 '?': 
  30.                     myStr := kFormStr;
  31.                 otherwise
  32.                     myStr := concat('error: ', myStr);
  33.             end;
  34.             paramPtr^.returnValue := PasToZero(paramPtr, myStr);
  35.             exit(main);
  36.         end;
  37.  
  38.  { ----------------------------- }
  39.  
  40.         procedure GetParameters (var theType: resType);
  41.             var
  42.                 tempStr: str255;
  43.         begin
  44.             tempStr := '?';
  45.             if paramPtr^.paramCount > 0 then
  46.                 if (paramPtr^.params[1] <> nil) then
  47.                     begin
  48.                         Hlock(paramPtr^.params[1]);
  49.                         ZeroToPas(paramPtr, paramPtr^.params[1]^, tempStr);
  50.                         Hunlock(paramPtr^.params[1]);
  51.                     end;
  52.  
  53.             if tempStr[1] in ['!', '?'] then
  54.                 HandleError(tempStr[1]);
  55.  
  56.             if length(tempStr) = 3 then
  57.                 tempStr := concat(tempStr, space);
  58.             if length(tempStr) <> 4 then
  59.                 HandleError(kBadTypeCode)
  60.             else
  61.                 theType := tempStr;
  62.         end;
  63.  
  64.  { ----------------------------- }
  65.  
  66.         procedure FindSysResources (theType: resType; var outputH: handle);
  67.             const
  68.                 kSysRefNum = 0;
  69.             var
  70.                 oldResFileNum, i, numResThisType, resID: integer;
  71.                 endOfList: ptr;
  72.                 resSize: longint;
  73.                 resH: handle;
  74.                 dummyType: resType;
  75.                 resName, resInfoStr, tempStr: str255;
  76.                 err: OSErr;
  77.  
  78.         begin
  79.             oldResFileNum := CurResFile;
  80.             UseResFile(kSysRefNum);
  81.  
  82.             numResThisType := Count1Resources(theType);
  83.             if numResThisType = 0 then
  84.                 outputH := nil
  85.             else
  86.                 begin
  87.                     outputH := NewHandle(0);
  88.                     for i := 1 to numResThisType do
  89.                         begin
  90.                             resH := Get1IndResource(theType, i);
  91.                             if resH <> nil then
  92.                                 begin
  93.                                     resSize := GetHandleSize(resH);
  94.                                     GetResInfo(resH, resID, dummyType, resName);
  95.                                     ReleaseResource(resH);
  96.                                     resInfoStr := concat(theType, space);
  97.                                     NumToString(resID, tempStr);
  98.                                     resInfoStr := concat(resInfoStr, tempStr, space);
  99.                                     NumToString(resSize, tempStr);
  100.                                     resInfoStr := concat(resInfoStr, tempStr, space, resName, return);
  101.                                     err := PtrAndHand(@resInfoStr[1], outputH, length(resInfoStr));
  102.                                     if err <> noErr then
  103.                                         leave;
  104.                                 end;
  105.                         end;
  106.                 end;
  107.  
  108.             UseResFile(oldResFileNum);
  109.  
  110.         { To add a null char to the handle,   }
  111.         { we overwrite the final return char. }
  112.  
  113.             if outputH <> nil then
  114.                 begin
  115.                     endOfList := pointer(ord4(outputH^) + GetHandleSize(outputH) - 1);
  116.                     endOfList^ := 0;
  117.                 end;
  118.         end;
  119.  
  120.   { ------------------ main ------------------ }
  121.  
  122.         var
  123.             theType: resType;
  124.             outputH: handle;
  125.     begin
  126.         GetParameters(theType);
  127.         FindSysResources(theType, outputH);
  128.         paramPtr^.returnValue := outputH;
  129.     end;
  130. end.